perm filename M11C.OL2[M11,LCS] blob sn#409381 filedate 1979-01-07 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	CFORS3     FORTRAN UNIT GENERATOR ROUTINE     
C00021 ENDMK
CāŠ—;
CFORS3     FORTRAN UNIT GENERATOR ROUTINE     
C    *** MUSIC V ***     
      SUBROUTINE FORSAM   
	DIMENSION ENVP(27)
C ENVP STORES POINTERS FOR 'ENV' ARRAY. SEE AT 105 FOR INFO.
	COMMON /LM/L(10),M(10),NSAMX
C CAN USE UP TO 10 FIELDS IN UNIT GEN.
      COMMON I(1) /P/P(1) /GENS/GENS(1) /LFUNC/LFUNC,XNFUN
	1 /XIN/AMP,FREQ
	COMMON /INS/INS(1) /NT/RNT(1) /ROUT/ROUT(1)
C  INS=INSTRUMENT DEFINITIONS, RNT=NOTE CARD INFO, ROUT=OUTPUT BLOCK
      EQUIVALENCE(M1,M(1)),(M2,M(2)),(M3,M(3)),(M4,M(4)),(M5,M(5)),(M6,M
     1(6)),(M7,M(7)),(M8,M(8)),(L1,L(1)),(L2,L(2)),(L3,L(3)),(L4,L(4)),(  
     2 L5,L(5)),(L6,L(6)),(L7,L(7)),(L8,L(8)),(AMP,XIN1),(FREQ,XIN2)
	3 ,(I5,I(5)),(I6,I(6)),(I3,I(3)),(L9,L(9))
CC      XNFUN=LFUNC-1      
C     COMMON INITIALIZATION OF GENERATORS     
CX    N1=I6+2   
C I6 HAS POINTER TO CODE (IN INS ARRAY) FOR U.G. NOW TO BE PROCESSED.
CX	N2=INS(N1-1)-1
CX    DO 204 J1=N1,N2      
CX    J2=J1-N1+1  
CX	IF(INS(J1).GE.0)GO TO 201
CX200  L(J2)=-INS(J1)
CX    M(J2)=1     
CX    GO TO 204     
CX201  M(J2)=0     
CX 	IF(INS(J1)-26262.GT.0)GO TO 203
C***** WHAT DOES THE BIG NUMBER DO?????
C*** IT SEEMS TO BE JUST TO MAKE A FLAG. NOW CHANGED TO FIT INTO 16BITS.
CX202  L(J2)=INS(J1)+I3-1 
CX    GO TO 204     
CX203  L(J2)=INS(J1)-26262  
CX204  CONTINUE    
CX    N3=INS(I6)  
CX	IF(M1.LE.0)AMP=RNT(L1)      
CX 	IF(M2.LE.0)FREQ=RNT(L2)     
CX    J3=  N3 -100     
	CALL INITIT(J3)
  	AMP=RNT(L1)      
   	FREQ=RNT(L2)     
      NSAM=I5   
      NSAMX=NSAM-1
C            OUT OSC AD2 RAI ENV STR AD3 AD4 MLT DIV RAH 
      GO TO (101,102,103,104,105,106,107,108,109,110,111,112,113,114,
	1 115,116),J3     
CC	IF(NGEN.EQ.14)CALL OPT(L,M,NSAM)
C  FOLLOWING IS SUGGESTED HEADER FOR SUBROUTINE OPT
C	SUBROUTINE OPT(L,M,NSAM)
C	DIMENSION L(8),M(8)     
C	COMMON /GENS/GENS(1)/LFUNC/LFUNC/NT/RNT(1)/ROUT/ROUT(1)
 112  CALL OPT(J1,J2,J3)
113	RETURN
114	RETURN

C     UNIT GENERATORS    
C     OUTPUT BOX  
CX 101  IF(M1.LE.0)IN1=RNT(L1) 
CX    DO 270 J3=0,NSAM-1
CX    IF(M1.GT.0)IN1=ROUT(J3+L1)
CX 265  J5=L2+J3  
CX    ROUT(J5)=IN1+ROUT(J5)    
CX 270  CONTINUE    
CX    RETURN      
101	CALL OUTP
C CALLS 'FAIL' OUT BOX
	RETURN
CC101   DO 270 K=0,NSAMX 
      J5=L2+K
270   ROUT(J5)=ROUT(J5)+ROUT(K+L1)
      RETURN
C OUTPUT=WHAT'S THERE ALREADY + WHAT'S COMING IN FROM THIS INST.
C  THIS NEW FORM ASSUMES THE OUT BOX HAS ONLY 'Bn' AS INPUT.

C     OSCILLATOR    L1,L2 = P or B   L3=B   L4=F or P   L5=P
C			AMPL, TIME, OUTPUT,  FUNC,    5TH NO LONGER USED.
C M1, M2 =1 = NT.  =0 = ROUT  (P=FIXED INPUT, B=DYNAMIC INPUT, F=FUNC.)
102	CALL OSC
C  CALL 'FAIL' OSC.
	RETURN
CXX 102  SUM=RNT(L5)      
	CALL LOCGEN(M4,L4)
C  FINDS POINTER TO FUNC NUM.  IF M4.EQ.1 THEN FNUM WAS IN INST DEF. 
CC	IF(M1.LE.0)AMP=RNT(L1)      
CC   	IF(M2.LE.0)FREQ=RNT(L2)     
      DO 293 J3=0,NSAMX  
      J4=INT(SUM)+L4     
      F=GENS(J4)     
C GENS(J4) IS IN FUNC STORAGE AREA.
	IF(M2.GT.0)GO TO 286
      SUM=SUM+FREQ
      GO TO 290     
 286  J4=L2+J3
      SUM=SUM+ROUT(J4)  
290     IF(SUM.GE.XNFUN)SUM=SUM-XNFUN
CC290     IF(SUM.GE.XNFUN)GO TO 287
CC     IF(SUM.LT.0.0)GO TO 289
 288  J5=L3+J3
	IF(M1.GT.0)GO TO 292
      ROUT(J5)=AMP*F     
      GO TO 293     
C**********
CC287    SUM=SUM-XNFUN
CC     GO TO 288
CC289    SUM=SUM+XNFUN
CC     GO TO 288
C******* ABOVE FOR FM (NEG. FREQ. TO OSCIL)
 292  J6=L1+J3
      ROUT(J5)=ROUT(J6)*F
 293  CONTINUE    
      RNT(L5)=SUM      
C L5 POINTS TO NOTE ARRAY.     SAVE A POINTER.
      RETURN      

C 115 NEG OSCILLATOR  L1,L2 = P or B   L3=B   L4=F or P   L5=P
C 'NOS'			 AMPL, TIME, OUTPUT,  FUNC,    5TH NO LONGER USED.
C M1, M2 =1 = NT.  =0 = ROUT  (P=FIXED INPUT, B=DYNAMIC INPUT, F=FUNC.)
115   SUM=RNT(L5)      
	CALL LOCGEN(M4,L4)
C  FINDS POINTER TO FUNC NUM.  IF M4.EQ.1 THEN FNUM WAS IN INST DEF. 
CC	IF(M1.LE.0)AMP=RNT(L1)      
CC   	IF(M2.LE.0)FREQ=RNT(L2)     
      DO 150 J3=0,NSAMX  
      J4=INT(SUM)+L4     
      F=GENS(J4)     
C GENS(J4) IS IN FUNC STORAGE AREA.
	IF(M2.GT.0)GO TO 151
      SUM=SUM+FREQ
      GO TO 152
151   J4=L2+J3
      SUM=SUM+ROUT(J4)  
152     IF(SUM.GE.XNFUN)GO TO 153
       IF(SUM.LT.0.0)GO TO 154
155   J5=L3+J3
	IF(M1.GT.0)GO TO 156
      ROUT(J5)=AMP*F     
      GO TO 150     
C**********
153    SUM=SUM-XNFUN
       GO TO 155
154    SUM=SUM+XNFUN
       GO TO 155
C******* ABOVE FOR FM (NEG. FREQ. TO OSCIL)
156   J6=L1+J3
      ROUT(J5)=ROUT(J6)*F
150   CONTINUE    
      RNT(L5)=SUM      
C L5 POINTS TO NOTE ARRAY.     SAVE A POINTER.
      RETURN      

C     ADD TWO BOX 
C LOOK AT NT ARRAY FOR FIXED VALUES, LOOK AT ROUT FOR CHANGING VALS.
CC103	IF(M1.LE.0)XIN1=RNT(L1)   
CC      IF(M2.LE.0)XIN2=RNT(L2)   
103      DO 258 J3=0,NSAMX    
	IF(M1.GT.0)XIN1=ROUT(J3+L1)
    	IF(M2.GT.0)XIN2=ROUT(L2+J3)
      ROUT(J3+L3)=XIN1+XIN2      
 258  CONTINUE    
      RETURN      

C 116  SUBTRACT
CC116	IF(M1.LE.0)XIN1=RNT(L1)   
CC      IF(M2.LE.0)XIN2=RNT(L2)   
116      DO 1016 J3=0,NSAMX    
	IF(M1.GT.0)XIN1=ROUT(J3+L1)
    	IF(M2.GT.0)XIN2=ROUT(L2+J3)
      ROUT(J3+L3)=XIN1-XIN2      
 1016  CONTINUE    
      RETURN      

C RANDOM INTERPOLATING GENERATOR   RAI Px Py Bn Pq Pr Ps; OR RAI L1 L2 L3 L4 L5 L6;
C M1=0=Pn   M1=1=Bn
 104  SUM=RNT(L4)      
	  RN1=RNT(L5)  
      RN3=RNT(L6)  
CC	IF(M1.LE.0)XIN1=RNT(L1)     
CC   	IF(M2.LE.0)XIN2=RNT(L2)     
	IF(SUM.NE.0)GO TO 313
	CALL RNDM(RN1)
	CALL RNDM(RN3)
C INIT THE RANDOM NUMBERS.
313      DO 340 J3=0,NSAMX    
	IF(M1.GT.0)XIN1=ROUT(J3+L1)     
    	IF(M2.GT.0)XIN2=ROUT(J3+L2)     
      IF(XNFUN.GT.SUM)GO TO 320
CC    IF(SUM-XNFUN.LT.0)GO TO 320
      SUM=SUM-XNFUN      
	CALL RNDM(RN4)
304      RN2=RN4-RN3 
      RN1=RN3     
      RN3=RN4     
      GO TO 321     
 320  RN2=RN3-RN1 
321   ROUT(J3+L3)=XIN1*(RN1+(RN2*SUM)/XNFUN)   
      SUM=SUM+XIN2
 340  CONTINUE    
      RNT(L4)=SUM       
      RNT(L5)=RN1  
      RNT(L6)=RN3  
      RETURN      

C     ENVELOPE GENERATOR   ENV PorB, ForP, B,  P,   P,   P,  P,  P;
C			       AMPL FUNC OUT ATCK STDY DCAY FLAG STOR
C FLAG=1=NO CONTINUATION, REINITS FOR EACH NOTE AND CAN PLAY ON TOP OF SELF.
C FLAG=0=INIT CONTINUATION FOR SEVERAL NOTES UNDER 1 ENV.
C		(USE DIFFERENT INS. NUMS FOR CHORDS!!)
105	L9=RNT(L1-3)
C  GET INS. NUM.
	ENVX=RNT(L7)
	IF(ENVX)805,605,905
905	SUM=RNT(L8)
	GO TO 705
805	SUM=ENVP(L9)      
	GO TO 705
605	SUM=0
	RNT(L7)=-1.
705	CALL LOCGEN(M2,L2)
C  FINDS POINTER TO FUNC NUM.  IF M2.EQ.1 THEN FNUM WAS IN INST DEF. 
      XIN4=RNT(L4)
      XIN5=RNT(L5)
      XIN6=RNT(L6)
      XIN5=1./(1./XIN5 - 1./XIN4 -1./XIN6 )
C XIN5 HAS INCR. VALUE OF STEADY STATE. (IT WAS TOTAL DUR. BEFORE.)
C THESE 3 PARAMS ARE ATTACK DUR, TOTAL DUR, DECAY DUR.
C  STEADY STATE TIME IS COMPUTED
CC	IF(M1.LE.0)AMP =RNT(L1)     
CX 	IF(M4.LE.0)XIN4=FLOAT(RNT(L4))*SFI     
CX 	IF(M5.LE.0)XIN5=FLOAT(RNT(L5))*SFI     
CX 	IF(M6.LE.0)XIN6=FLOAT(RNT(L6))*SFI     
      XIN4=XIN4/4.
      XIN5=XIN5/4.
      XIN6=XIN6/4.
 387  X1=XNFUN/4. 
      X2=2.*X1    
      X3=3.*X1    
      DO 205 J3=0,NSAMX    
      J4=INT(SUM)+L2     
      F=GENS(J4)     
	IF(M1.GT.0)AMP =ROUT(J3+L1)      
   	IF(SUM-XNFUN.GE.0)SUM=SUM-XNFUN      
   	IF(SUM-X1.GT.0)GO TO 305
CX  	IF(M4.GT.0)XIN4=FLOAT(ROUT(J3+L4))      
      SUM=SUM+XIN4       
      GO TO 405    
305	IF(SUM-X2.GT.0)GO TO 505
CX  	IF(M5.GT.0)XIN5=FLOAT(ROUT(J3+L5))      
      SUM=SUM+XIN5       
      GO TO 405    
CX505	IF(M6.GT.0)XIN6=FLOAT(ROUT(J3+L6))      
505   SUM=SUM+XIN6       
 405  J7=L3+J3
      ROUT(J7)=AMP*F     
 205  CONTINUE   
	IF(ENVX.LE.0)GO TO 1005
	RNT(L8)=SUM
	RETURN
1005  ENVP(L9)=SUM       
      RETURN     

C     STEREO OUTPUT BOX  L1,L2 = B       L3=B1
C IT IS ASSUMED ALL INPUTS ARE 'B' TYPE.
106   NSSAM=2*NSAM       
C  6/29/70  L.C.SMITH
      ICT=0
      DO 206 J3=1,NSSAM,2  
      J4=L1+ICT
      XIN1=ROUT(J4)  
 306  J5=L3+J3-1 
      ROUT(J5)=XIN1+ROUT(J5)    
506   J4=L2+ICT
      XIN2=ROUT(J4)  
 406  J5=L3+J3   
      ROUT(J5)=XIN2+ROUT(J5)    
 206  ICT=ICT+1  
      RETURN     
C     STEREO OUTPUT BOX  
CX106	IF(M1.GT.0)GO TO 501
CCC 106  IF(M1)500,500,501  
CX 500  IN1=I(L1)  
CX501	IF(M2.GT.0)GO TO 503
CCC 501  IF(M2)502,502,503  
CX 502  IN2=I(L2)  
CX 503  NSSAM=2*NSAM       
C  6/29/70  L.C.SMITH
CX      ICT=0
CX      DO 206 J3=1,NSSAM,2  
CX	IF(M1.LE.0)GO TO 306
CCC   IF(M1)306,306,504  
CC*** 504  J4=L1+J3-1 
CX504   J4=L1+ICT
CX      IN1=I(J4)  
CX 306  J5=L3+J3-1 
CX      I(J5)=IN1+I(J5)    
CX	IF(M2.LE.0)GO TO 406
CCC   IF(M2)406,406,506  
CC*** 506  J4=L2+J3-1 
CX506   J4=L2+ICT
CX      IN2=I(J4)  
CX 406  J5=L3+J3   
CX      I(J5)=IN2+I(J5)    
CX 206  ICT=ICT+1  
CX      RETURN     

C     ADD 3 BOX  
CC107	IF(M1.LE.0)XIN1=RNT(L1)  
CC   	IF(M2.LE.0)XIN2=RNT(L2)  
107   	IF(M3.LE.0)XIN3=RNT(L3)  
      DO 780 J3=0,NSAMX    
	IF(M1.GT.0)XIN1=ROUT(L1+J3)
   	IF(M2.GT.0)XIN2=ROUT(L2+J3)
   	IF(M3.GT.0)XIN3=ROUT(L3+J3)
      ROUT(J3+L4)=XIN1+XIN2+XIN3  
 780  CONTINUE   
      RETURN     

C     ADD 4 BOX  
CC 108  IF(M1.LE.0)XIN1=RNT(L1)  
CC      IF(M2.LE.0)XIN2=RNT(L2)  
108      IF(M3.LE.0)XIN3=RNT(L3)  
      IF(M4.LE.0)XIN4=RNT(L4)  
      DO 880 K=0,NSAMX    
      IF(M1.GT.0)XIN1=ROUT(L1+K)  
 859  IF(M2.GT.0)XIN2=ROUT(L2+K)
      IF(M3.GT.0)XIN3=ROUT(L3+K)
 863  IF(M4.GT.0)XIN4=ROUT(L4+K)
      ROUT(L5+K)=XIN1+XIN2+XIN3+XIN4      
880   CONTINUE   
      RETURN     

C     MULTIPLIER 
CC109   IF(M1.LE.0)XIN1=RNT(L1)
CC      IF(M2.LE.0)XIN2=RNT(L2)
109      DO 908 J3=0,NSAMX
      IF(M1.GT.0)XIN1=ROUT(J3+L1)
      IF(M2.GT.0)XIN2=ROUT(J3+L2)
      ROUT(J3+L3)=XIN1*XIN2
 908  CONTINUE   
      RETURN     

C 110 DIVIDER
CC110   IF(M1.LE.0)XIN1=RNT(L1)
CC      IF(M2.LE.0)XIN2=RNT(L2)
110      DO 1010 J3=0,NSAMX
      IF(M1.GT.0)XIN1=ROUT(J3+L1)
      IF(M2.GT.0)XIN2=ROUT(J3+L2)
1010      ROUT(J3+L3)=XIN1/XIN2
      RETURN     


C     SET NEW FUNCTION IN OSC OR ENV     
CC 110  ILOC=N1+6  
CC      IF(INS(N1+1).EQ.105) ILOC=N1+4 
CC      JN1=I(3)+INS(N1)-1   
CC      IIN1=RNT(JN1)
CC     IF(IIN1.GT.0) INS(ILOC)=-(IIN1-1)*LFUNC-1    
C 'SET' NO LONGER NEEDED!!!!  NOW 110 CAN BE USED FOR SOMETHING ELSE.

C     RANDOM AND HOLD GENERATOR     RAH Px Py Bn Pq Pr; OR RAH L1 L2 L3 L4 L5;
C M1=0=Pn   M1=1=Bn
 111  SUM=RNT(L4)       
CC      IF(M1.LE.0)XIN1=RNT(L1)      
CC      IF(M2.LE.0)XIN2=RNT(L2)      
 913  RN=RNT(L5)  
	IF(SUM.EQ.0)CALL RNDM(RN)
C TO INIT RANDOM NUMB.  (COULD THIS EVER LOSE?)
      DO 940 J3=0,NSAMX    
      IF(M1.GT.0) XIN1=ROUT(J3+L1)      
      IF(M2.GT.0) XIN2=ROUT(J3+L2)      
      IF(XNFUN.GT.SUM)GO TO 920
CC    IF(SUM-XNFUN.LT.0)GO TO 920
      SUM=SUM-XNFUN      
	CALL RNDM(RN)
920   ROUT(J3+L3)=XIN1*RN 
      SUM=SUM+XIN2       
 940  CONTINUE   
      RNT(L4)=SUM       
      RNT(L5)=RN  
      RETURN     
      END

	SUBROUTINE RNDM(X)
	X=2.*RAN(X)-1.
C SENDS BACK NUMBER BETWEEN -1 AND +1
	END

	SUBROUTINE LOCGEN(M,L)
	COMMON /NT/RNT(1) /LOCG/LOCG(1)
	IF(M.EQ.0)L=LOCG(INT(RNT(L)))
C GET POINTER TO START OF FUNC. ARRAY
	END

 	SUBROUTINE OPT(L,M,NSAM)
 	DIMENSION L(1),M(1)     
 	COMMON /GENS/GENS(1)/LFUNC/LFUNC,XNFUN
	1/NT/RNT(1)/ROUT/ROUT(1)
C THIS IS A DUMMY ROUTINE     OPT Pm Pn Bn;  doubles value of Bn
	J1=L(3)
C L(3) MEANS LOOK AT 3RD FIELD OF 'OPT'
	J2=J1+NSAM-1
	DO 1 K=J1,J2   
1	ROUT(K)=ROUT(K)*2
	RETURN
	END